home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 18 / CU Amiga Magazine's Super CD-ROM 18 (1997)(EMAP Images)(GB)[!][issue 1998-01].iso / CUCD / Programming / ARexxGuide / OS2.x_Version / ARx_Setup.rexx < prev    next >
OS/2 REXX Batch file  |  1994-04-06  |  26KB  |  679 lines
  1. /* ARx_Setup.rexx version 1.2  (05 Apr 1994)                          **
  2. ** Called by help key, launch program, and requester port to set up   **
  3. ** env: variables and other information needed for utility progs.     */
  4.  
  5.    /* CallProg  := (LAUNCH|HELP|REQPORT) : code for calling script    **
  6.    ** SetWhat   := what values should be set? (not used now)          **
  7.    ** Envir     := used by help keys. Address of the calling script   */
  8.  
  9. /* Special thanks to John A. Conant for fixes to the OS 3.x parts,    **
  10. ** and to Steve Plegge and Doug Tittle for pointing out some of the   **
  11. ** many problems with the initial version.                            */
  12.  
  13. options results
  14. arg CallProg ., SetWhat, Envir
  15.  
  16. signal on syntax
  17.  
  18.     /* The AG library doesn't seem to set a proper return code for ARexx **
  19.     ** and has been known to cause crashes on some systems, so...        */
  20. call remlib('amigaguide.library')
  21.  
  22. if open(6HereWin, 'raw:14/60/360/48/Arx_Setup.rexx/NOCLOSE/SCREEN *') then do
  23.    call writech(6HereWin,'9b302070'x'Getting setup information for ARexxGuide.'||'0a'x'Please answer a few questions.')
  24. end
  25.  
  26.    /* Default sets everything at once                                 */
  27. if CallProg = '' then CallProg = 'GEN'
  28.  
  29. if CallProg = 'GEN' then
  30.     AddBackLibs = RemUnknownLib()
  31. else
  32.     AddBackLibs = ''
  33.  
  34. if ~checklib('rexxsupport.library',0,-30) then signal NOSUPPORT
  35.  
  36. MultiRq. = 0
  37. call makedir('env:ARexxGuide')
  38.  
  39.     /* Used to determine if .rexx scripts should be copied.            */
  40. parse source . . . SetupPath
  41.     SetupPath = strip(ParseFileName(SetupPath, P),b)
  42. if pos('Ram Disk:', SetupPath) = 1 then
  43.      SetupPath = delstr(SetupPath, 4 ,5)
  44.  
  45. csi='9b'x;k!.slant=csi'3m';k!.bold=csi'1m';k!.norm=csi'0m';k!.black=csi'31m';k!.white=csi'32m';k!.blue=csi'33m'
  46.  
  47.  
  48.    /* Function returns either 1 if rexxarplib is available or    **
  49.    ** 0 if it isn't. [RArp] and [ReqT] can be used later as the  **
  50.    ** condition in IF statements.                                */
  51. DReq = 0
  52. if CheckLib('rexxreqtools.library',32) then do
  53.     /* addlib() won't let us check for the decimal on a version   **
  54.     ** so this assures us that 37.50 is the minimum version used. */
  55.     RqLibVer = LibVer('rexxreqtools.library')
  56.     if RqLibVer >= 37.50 then
  57.         ReqT = 1
  58.    else do
  59.        ReqT = 0
  60.        call remlib('rexxreqtools.library')
  61.        if RqLibVer > -1 then
  62.            SetReqWarn = 1 /* After we know more about system, we'll warn folks */
  63.    end
  64. end
  65. else ReqT = 0
  66.  
  67.    /* Use requester commands if they are available.              */
  68. if ~ReqT then
  69.    if exists('c:requestchoice') then do
  70.          /* Copy under new name so we can delete them later without  **
  71.          ** deleting a copy that user might have put into t:         */
  72.       address command 'copy c:requestchoice t:rqchoice'
  73.       address command 'copy c:requestfile t:rqfile'
  74.       DReq = 1
  75.    end
  76.  
  77. if CheckLib('rexxarplib.library') then do
  78.       /* Set a default position */
  79.    if getclip('RASLpos') = '' then
  80.       call setclip('RASLpos', '20 50 354 300 #?')
  81.    RArp = 1
  82. end
  83. else RArp = 0
  84.  
  85.     /* Tell user we've removed rexxreqtools.library */
  86. if SetReqWarn = 1 then do
  87.     call InfoReq('ARexxGuide utilities', 'A minimum version of 37.50 is required\by ARexxGuide for rexxreqtools.library.\\The version on your system will not\be used.','OK')
  88. end
  89.  
  90. call pragma('w', Null)
  91. GoodAGPath = 0
  92. CurAGPath = GetEnv('amigaguide/path')
  93. do i = 1 to words(CurAGPath)
  94.     if exists(AddPathPart(word(CurAGPath,i), 'ARexxGuide.guide')) then do
  95.         GoodAGPath = 1
  96.         leave
  97.     end
  98. end
  99. call pragma('w')
  100. if ~GoodAGPath then do CheckPath = 1
  101.    call InfoReq('Choose ARexxGuide directory.','Pick the directory where ARexxGuide\files were stored.','OK')
  102.     if pos('REXX', upper(SetupPath)) = 0 then
  103.         ARxPath = SetupPath
  104.     else
  105.         ArxPath = pragma('d')
  106.     if pos('Ram Disk:', ArxPath) = 1 then
  107.          ArxPath = delstr(ArxPath, 4 ,5)
  108.    ArxPath = strip(FileInfoReq(ARxPath,,'Choose ARexxGuide directory.',1),'T', '/')
  109.    if ~exists(AddPathPart(ARxPath, 'ARexxGuide.guide')) | ARxPath = '' then do
  110.       if InfoReq('Problem with chosen path.','Sorry.\The file ARexxGuide.guide can''t be found\in' ARxPath'.\\It is one of the files in archive.\Try again?', 'BOOL') then
  111.          iterate
  112.       else
  113.           signal NOARXPATH
  114.    end
  115.    if find(upper(CurAGPath), upper(ARxPath)) = 0 then do
  116.        call makedir('env:AmigaGuide')
  117.        call setenv('AmigaGuide/path', strip(CurAGPath ARxPath, l))
  118.     end
  119.     break /* because this is in a loop */
  120. end
  121.  
  122. if find('LAUNCH HELP GEN', CallProg) > 0 then do
  123.    /* Set the command to be used to show AG files               */
  124.    AGCmd = getenv('ARexxGuide/AGCmd')
  125.       /* Check for file only when this var is not already set   */
  126.    if AGCmd > '' then do
  127.       AGDir = ParseFileName(AGCmd, 'P')
  128.       AGProg = ParseFileName(AGCmd)
  129.    end
  130.    else do
  131.       call pragma('w', null)     /* Turn off volume requesters */
  132.       if exists('SYS:Utilities') then
  133.          AGDir = 'SYS:Utilities'
  134.       else
  135.          AGDir = ''
  136.       if exists('SYS:Utilities/AmigaGuide') then
  137.          AGProg = 'AmigaGuide'
  138.       else
  139.          AGProg = 'Multiview'
  140.       call pragma('W')           /* Turn requesters on again   */
  141.    end
  142.  
  143.    if (~exists(AGCmd) | AGCmd = '') then do
  144.       call InfoReq('Choose AmigaGuide utility', 'The program needs information about\the location of your AmigaGuide utility.\Please choose the program you use\to view AmigaGuide files.', 'OK')
  145.        CheckARxCmd = 1
  146.    end
  147.    else if abbrev(CallProg, 'GEN') then
  148.       if InfoReq('ARexxGuide help system','Would you like to change setting of\command variable?\\Current:\  'AGCmd, 'BOOL') then
  149.             CheckARxCmd = 1
  150.  
  151.     if CheckARxCmd = 1 then do
  152.             /* We have a default value, now ask for the real thing   */
  153.       AGCmd = FileInfoReq(AGDir, AGProg, 'Choose AmigaGuide utility')
  154.       if AGCmd = '' then
  155.          signal NOARXPATH
  156.       else
  157.          call setenv('ARexxGuide/AGCmd', AGCmd)
  158.    end
  159.  
  160.  
  161.    if find('LAUNCH GEN', CallProg) > 0 then do
  162.          /* Launch prog. uses rexxarplib to open & control a pub screen */
  163.       if RArp then
  164.          if InfoReq('ARexxGuide public screen','Do you want ARexxGuide to open on\its own public screen?', 'BOOL') then
  165.             PubScr = 'ARX_GUIDE'
  166.          else
  167.             PubScr = 'WORKBENCH'
  168.       else PubScr = 'WORKBENCH'
  169.       call setenv('ARexxGuide/PubScr', PubScr)
  170.    end
  171.    if find('HELP GEN', CallProg) > 0 then do
  172.            /* Get paths for help key */
  173.       if InfoReq('Choose cross-ref files','Pick OK to add cross-ref files\from other guides to be loaded\with the help system.\\You will be able to choose from\multiple directories.\Pick from initial dir now.\\Directories will be added to\env:AmigaGuide/path.', 'CANCEL') then do
  174.             CurAGPath = GetEnv('amigaguide/path')
  175.          XRfiles = getenv('ARexxGuide/XRFiles')
  176.          XCount = 1
  177.          XAddMore = 1   /* Default for first time through */
  178.          do until XAddMore = 0
  179.             /* Open a display console for current choices.  */
  180.             if XRFiles > '' then do
  181.                if ~show('F', 'XRdisplay') then
  182.                   call open('XRdisplay', 'con:180/0/220/300/XRef files chosen:','R')
  183.                      /* Check again in case it didn't open       */
  184.                if show('F', 'XRdisplay') then
  185.                   do i = XCount to words(XRfiles)
  186.                      call writeln('XRdisplay', ParseFileName(word(XRFiles, i)))
  187.                   end
  188.                XAddMore = InfoReq('Cross-ref files','Add files from other directories?','BOOL')
  189.                XCount = i
  190.             end
  191.             if XAddMore then do
  192.                call FileInfoReq(ParseFileName(value('MultiRq.'MultiRq.0),'P'),,'Choose cross-ref files.',,1)
  193.                   if MultiRq.0 > 0 then
  194.                       XPath = ParseFileName(MultiRq.1, P)
  195.                   else
  196.                       XPath = ''
  197.                do CheckX = 1 to MultiRq.0
  198.                        /* Make sure it's not repeated */
  199.                      Xfile = ParseFileName(MultiRq.CheckX)
  200.                   if find(XRFiles, Xfile) = 0 then do
  201.                           /* is it missing the .xref extension */
  202.                       if pos('.XREF', upper(Xfile)) = 0 then do
  203.                           if exists(MultiRq.CheckX'.xref') then
  204.                               Xfile = Xfile'.xref'
  205.                           else if open(6CheckX, MultiRq.CheckX, R) then do
  206.                                if ~abbrev(upper(readch(6CheckX, 12)), 'XREF:') then
  207.                                    iterate CheckX
  208.                            end
  209.                       end
  210.                      XRfiles = XRfiles Xfile
  211.                   end
  212.                end
  213.                     /* Drop out if no files were chosen in the requester */
  214.                    if MultiRq.0 = 0 then
  215.                        XAddMore =  0
  216.                         /* Add dir to path if it isn't there already */
  217.                     else if find(upper(CurAGpath), upper(Xpath)) = 0 then do
  218.                         SetAGpath = 1
  219.                         CurAGpath = CurAGpath Xpath
  220.                     end
  221.             end
  222.             end
  223.            call setenv('AmigaGuide/path', CurAGpath)
  224.             call setenv('ARexxGuide/XRFiles', XRfiles)
  225.       end
  226.         call close 'XRdisplay'
  227.             /* Should the fullhelp window be displayed? */
  228.       if Rarp then do
  229.           if InfoReq('ARexxGuide help system','Would you like to see a window with\information about the current clause\when help system doesn''t find a\match for chosen word?', 'BOOL') then
  230.                 call setenv( 'ARexxGuide/ShowFullHelp', 1)
  231.             else
  232.                 call setenv( 'ARexxGuide/ShowFullHelp', 0)
  233.         end
  234.    end
  235. end
  236.  
  237. if find('REQPORT GEN', CallProg) > 0 & ReqT then do
  238.     if CallProg = 'GEN' then
  239.         call setenv('ARexxGuide/RqVer', 0)
  240.     if CallProg = 'GEN' then
  241.         if ~InfoReq('ARexxGuide help system','Are you using the RQ (Requester) version?', 'BOOL') then
  242.             break /* Don't want to do the rest of this stuff */
  243.         else
  244.             call setenv('ARexxGuide/RqVer', 1)
  245.    CurFont = getenv('arexxguide/reqfont')
  246.    if pos('/', CurFont) > 0 then do
  247.        if InfoReq('Glossary requesters', 'Do you wish to change the font\used with reqesters?\\Current:' CurFont,'BOOL') then
  248.            FontReq = 1
  249.    end
  250.       else if InfoReq('Glossary requesters', 'Do you wish to specify a font\to be used with the glossary\requesters?','BOOL') then
  251.           FontReq = 1
  252.  
  253.    if FontReq = 1 then do
  254.       RqFont. = ''
  255.       call rtfontrequest('Choose font for requesters', ,,RqFont)
  256.       if RqFont.name > '' then
  257.          call setenv( 'ARexxGuide/ReqFont', RqFont.name'/'RqFont.height)
  258.    end
  259.            /* Ask about public screen only if it wasn't set in the LAUNCH part */
  260.     if symbol('PUBSCR') ~== 'VAR' then
  261.        if InfoReq('Glossary requesters','Do you display ARexxGuide on\a public screen other than\Workbench?','BOOL') then do
  262.            PubScr = getenv('ARexxGuide/PubScr')
  263.           if PubScr = '' then PubScr = 'ARX_GUIDE'
  264.            PubScr = rtgetstring('ARX_GUIDE', translate('What is the public screen name.\(Press OK to accept default name.)','0a'x,'\'),'Glossary requesters')
  265.            if PubScr > '' then
  266.               call setenv( 'ARexxGuide/PubScr', PubScr)
  267.        end
  268. end
  269.  
  270.     /* Copy .rexx scripts to REXX: if they're in the guide directory */
  271. if find(upper(translate(SetupPath,' ','/:')), 'REXX') = 0 then do
  272.     if InfoReq('Copy .rexx files', 'Do you want .rexx scripts for ARexxGuide\to be copied to REXX: directory?', 'BOOL') then do
  273.         address command
  274.         'copy >nil:' AddPathPart(SetupPath, '#?.(rexx|ed|TTX|edge)') 'REXX:' clone
  275.         if rc = 0 then do
  276.             'copy >nil:' AddPathPart(SetupPath, 'ARx_Setup.rexx.info') 't:'
  277.             'delete >nil:' AddPathPart(SetupPath, '#?.rexx(%|.info)')
  278.             'copy >nil: t:ARx_Setup.rexx.info' '"'SetupPath'"'
  279.             call delete('t:ARx_Setup.rexx.info')
  280.         end
  281.         address
  282.     end
  283. end
  284.  
  285.    /* Record that this session has already been run  */
  286. if CallProg = 'GEN' then
  287.    call setenv('ARexxGuide/Setup', 'HELP LAUNCH REQPORT')
  288.       /* Don't put multiple copies of name into env: var */
  289. else if find(getenv('ARexxGuide/Setup'), Callprog) = 0 then
  290.    call setenv( 'ARexxGuide/Setup', getenv('ARexxGuide/Setup') CallProg)
  291.  
  292. if InfoReq('Help system setup', 'Would you like to save this information\to disk so it will be available\permanently?', 'BOOL') then do
  293.    address command 'copy >nil: env:ARexxGuide/#? envarc:ARexxGuide'
  294.     if SetAGPath = 1 then
  295.       address command 'copy >nil: env:AmigaGuide envarc:AmigaGuide all'
  296. end
  297.  
  298.    /* get rid of copies of command that we might have put in t: */
  299. call delete 't:RqChoice'; call delete 't:RqFile'
  300. if AddBackLibs > '' then call ReturnLibs()
  301.  
  302. return 0
  303.  
  304.    /* This uses rexxarplib's GETENV() if it's here */
  305. GetEnv: procedure expose RArp
  306.  
  307.    EnvVar = ''
  308.    if RArp then
  309.       EnvVar = 'GetEnv'(arg(1))
  310.    else if open(6Env, 'env:'arg(1), R) then do
  311.       EnvVar = readln(6Env)
  312.       call close 6Env
  313.    end
  314.    return EnvVar
  315.  
  316. SetEnv: procedure expose RArp
  317.  
  318.    if RArp then
  319.       EnvVar = 'SetEnv'(arg(1), arg(2))
  320.  
  321.    if arg(2, 'E') then do
  322.       if open(6Env, 'env:'arg(1), 'W') then do
  323.          Success = (writech(6Env, arg(2)) > 0)
  324.          call close 6Env
  325.       end
  326.       else
  327.          Success = 0
  328.       return Success
  329.    end
  330.    else                    /* Var is deleted if there's no value to set */
  331.       return delete('env:'arg(1))
  332.  
  333. InfoReq: procedure expose RArp ReqT DReq Envir k!.
  334.    /* Puts up a Yes/No requester. Returns a Boolean                    **
  335.    **    Arguments:                                                    **
  336.    **       arg(1)  := title of requester                              **
  337.    **       arg(2)  := body text                                       **
  338.    **       arg(3)  := {OK | BOOL | CANCEL} -- type of requester       */
  339.  
  340.    select
  341.       when ReqT then do
  342.          Buttons = word('_Ok _Yes|_No _Ok|_Cancel', find('OK BOOL CANCEL', arg(3)))
  343.          return rtezrequest(translate(arg(2), '0a'x, '\'), Buttons, arg(1))
  344.       end
  345.       when DReq then do
  346.          Buttons = word('Ok Yes|No Ok|Cancel', find('OK BOOL CANCEL', arg(3)))
  347.             /* Add line-feed code if necessary */
  348.          BText = arg(2)
  349.          LfPos = pos('\', BText)
  350.          do while LfPos > 0
  351.             BText = insert('N',overlay('*',BText,LfPos),LfPos)
  352.             LfPos = pos('\', BText)
  353.          end
  354.          address command 't:RqChoice >env:RqPick' '"'arg(1)'"' '"'BText'"' '"'Buttons'"'
  355.             /* Get the response unless it's a simple OK */
  356.          RqPick = 0
  357.          if arg(3) ~= 'OK' then
  358.              return (getenv('RqPick') = 1)
  359.       end
  360.       when RArp then do
  361.          Buttons. = ''
  362.          select
  363.             when arg(3) = 'OK' then
  364.                return (request(word(getclip('RASLpos'),1),word(getclip('RASLpos'),2),arg(2),,' Ok ') = 'OKAY')
  365.             when arg(3) = 'BOOL' then
  366.                return (request(word(getclip('RASLpos'),1),word(getclip('RASLpos'),2),arg(2),,' Yes ',' No ') = 'OKAY')
  367.             otherwise
  368.                return (request(word(getclip('RASLpos'),1),word(getclip('RASLpos'),2),arg(2),,' Ok ', ' Cancel ') = 'OKAY')
  369.          end
  370.       end
  371.       otherwise
  372.          /* Open a raw: window to display information            */
  373.          depth = 68 + (11 * (countchar('\', arg(2))+3))
  374.          select
  375.             when arg(3) = 'OK' then
  376.                RspMsg = '0a'x '   <'k!.white'Press any key'k!.black'>'
  377.             when arg(3) = 'BOOL' then
  378.                RspMsg = '0a'x '   <'k!.white'Enter'k!.black'> or <'k!.white'Y'k!.black'> = "Yes"'|| '0a'x '   <'k!.white'Esc'k!.black'>   or <'k!.white'N'k!.black'> = "No"' || '0a'x '   <'k!.blue'Press a key'k!.black'>'
  379.             otherwise
  380.                RspMsg = '0a'x '   <'k!.white'Enter'k!.black'> or <'k!.white'Y'k!.black'> = "Ok"' || '0a'x '   <'k!.white'Esc'k!.black'>   or <'k!.white'N'k!.black'> = "Cancel"' || '0a'x '   <'k!.blue'Press a key<'k!.black'>'
  381.          end
  382.          if open(6Info, 'raw:10/20/346/'Depth'/'arg(1), w) then do
  383.             call writeln(6Info, translate(arg(2), '0a'x, '\'))
  384.             call writech(6Info, '0a'x || RspMsg)
  385.             resp = (verify(upper(readch(6Info)), '0d594f'x) = 0)
  386.             call close 6Info
  387.             return resp
  388.          end
  389.          else
  390.             return -1
  391.    end
  392.    return -1
  393.  
  394. FileInfoReq: procedure Expose RArp ReqT DReq Envir MultiRq. k!.
  395.    /* Puts up a file requester using the following choices:
  396.          1. RexxReqTools
  397.          2. RexxArpLib
  398.          3. ADos 3.0 requester commands (I hope)
  399.          3. An ugly console window
  400.    */
  401.  
  402.    parse arg /* InfoMsg,*/ DefDir, DefProg, Title, DirOnly, Multi
  403.    MultiRq. = 0
  404.    /* if InfoMsg > '' then call InfoReq(Title,InfoMsg,'OK') */
  405.    if DefDir = ''then do
  406.       parse value pragma('d') with DefDir ':'
  407.       DefDir = DefDir':'
  408.    end
  409.    select
  410.       when ReqT then do
  411.          if DirOnly = 1 then flags = 'RTFI_Flags=FREQF_NoFiles'
  412.          else flags = 'RTFI_Flags=FREQF_PatGad'
  413.          if Multi = 1 then flags = flags'|FREQF_MultiSelect'
  414.          ChFile = rtfilerequest(DefDir,DefProg, Title,,Flags,MultiRq)
  415.          MultiRq.0 = MultiRq.count  /* Switch to the standard counter */
  416.       end
  417.       when DReq then do
  418.          Opts = 'DRAWER "'DefDir'"'
  419.          if DefProg > '' then
  420.             Opts = Opts 'FILE "'File'"'
  421.          Opts = Opts 'Title "'Title'"'
  422.          if DirOnly = 1 then
  423.             Opts = Opts 'DRAWERSONLY'
  424.          if Multi = 1 then
  425.             Opts = Opts 'MULTISELECT'
  426.          address command 't:RqFile >env:FlPick' Opts
  427.          if rc = 0 then do
  428.              ChFile = GetEnv('FlPick')
  429.             if Multi = 1 then do
  430.                do i = 1 while ChFile > ''
  431.                   parse var ChFile '"' MultiRq.i '"' ChFile
  432.                end
  433.                MultiRq.0 = i
  434.             end
  435.             else
  436.                ChFile = strip(ChFile, B, '"')
  437.          end
  438.          else
  439.             ChFile = -10
  440.          call delete('env:FlPick')
  441.       end
  442.  
  443.       when RArp then do
  444.          if DirOnly = 1 then flags = 'NOFILES'
  445.          else flags = 'PATGAD'
  446.          if Multi = 1 then flags = flags'|MULTISELECT'
  447.          call GetFile(word(getclip('RASLpos'),1),word(getclip('RASLpos'),2),DefDir,DefProg,Title,,Flags,MultiRq,word(getclip('RASLpos'),3),word(getclip('RASLpos'),4),word(getclip('RASLpos'),5))
  448.             /* lib is returning everything in the compound variable */
  449.          if Multi ~= 1 then
  450.             ChFile = MultiRq.1
  451.             /* Record current position */
  452.          call setclip('RASLpos', MultiRq.LeftEdge MultiRq.TopEdge MultiRq.Width MultiRq.Height MultiRq.Pattern)
  453.       end
  454.      /*  when Envir > '' & show('P', Envir) then do
  455.          address value Envir
  456.          if abbrev(Envir, 'TURBO') then do
  457.             'RequestFile PROMPT "'Title'" PATH' AddPathPart(DefDir, DefProg)
  458.             if rc = 0 then
  459.                ChFile = result
  460.             else
  461.                ChFile = ''
  462.          end
  463.          else if abbrev(Envir, 'EDGE') then do
  464.             if DirOnly = 1 then Flags = 'DIR'
  465.             else Flags = ''
  466.             RqCmd = 'requestfile TITLE "'Title'" PATH' DefDir 'FILE' DefProg
  467.             if DirOnly = 1 then RqCmd = RqCmd 'GETDIR'
  468.             if Multi = 1 then RqCmd = RqCmd 'MULTISELECT'
  469.             address value Envir
  470.             ""RqCmd
  471.             if Multi ~= 1 then
  472.                ChFile = result
  473.             else do
  474.                if pos('(', result) > 0 then do
  475.                   parse value ' 'result with CommonPath '(' MultiFiles ')'
  476.                end
  477.                else do
  478.                   MultiFiles = result
  479.                   CommonPath = ''
  480.                end
  481.                do i = 1 until MultiFiles = ''
  482.                   parse var MultiFiles MultiRq.i '|'
  483.                   MultiRq.i = strip(AddPathPart(CommonPath, MultiRq.i))
  484.                end
  485.                MultiRq = i
  486.             end
  487.  
  488.             address              /* toggle back to whereever we were */
  489.          end
  490.       end  */
  491.       otherwise
  492.          call close STDOUT
  493.          if open(STDOUT, 'con:10/98/366/94/File name choice','R') then do
  494.             call close STDIN
  495.             call open(STDIN, '*', R)
  496.             /* pragma('*') is redundant on 2.0+ and WShell, but... */
  497.             /*call pragma('*', STDIN); call pragma('*', STDOUT)*/
  498.          end
  499.             /* if that didn't work we'll try for the best with the standard **
  500.             ** window defined in the icon (if that was used)                */
  501.          do forever  /* Break after checking for existence of file at end */
  502.             say k!.white||Title
  503.             say ''
  504.             say k!.blue'Please enter complete path of file'k!.black
  505.             options prompt k!.black'File?' k!.white'::: 'k!.black
  506.             parse pull ChFile
  507.             if ~exists(ChFile) | ChFile = '' then do
  508.                say ChFile 'is not a valid file name'
  509.                say k!.blue'Try again?'
  510.                options prompt k!.white'(y/n) ::: 'k!.black
  511.                pull resp
  512.                if abbrev(resp, 'Y') then iterate
  513.             end
  514.             /* If Multi is set, then return is expected in the compound */
  515.             if Multi = 1 then do
  516.                MultiRq.0 = MultiRq.0 + 1
  517.                interpret 'MultiRq.'MultiRq.0 '=' 'ChFile'
  518.                say k!.blue'Add another file?'
  519.                options prompt k!.white'(y/n) ::: 'k!.black
  520.                pull resp
  521.                if abbrev(resp, 'Y') then iterate
  522.              end
  523.              break
  524.          end
  525.        /* Works better not to close the window we've opened as STDOUT */
  526.    end
  527.    if ~exists(ChFile) then return -1
  528.    else return ChFile
  529.  
  530. AddPathPart: procedure
  531.    /* Add a filename to a path to make one spec.           */
  532.    /* A function that does this is available in rexxextend.library   */
  533.  
  534.    if verify(right(arg(1),1), '/:','m') = 0 then
  535.       FName = strip(arg(1)'/'arg(2),b,' "')
  536.    else
  537.       FName = strip(arg(1)arg(2),b,' "')
  538.    if pos('Ram Disk:', FName) = 1 then
  539.        FName = delstr(FName, 4 ,5)
  540.    if pos(' ', FName) > 0 then
  541.        return '"'FName'"'
  542.    else
  543.        return FName
  544.  
  545.  
  546. CountChar:
  547.    return length(arg(2)) - length(compress(arg(2), arg(1)))
  548.  
  549. ParseFileName: procedure
  550.    /* Arguments:                                                     **
  551.    ** FilePath   := Any valid AmigaDOS file specification            **
  552.    ** Part       := [Optional] 'F', 'FILE', or omit to get filename  **
  553.    **                          Anything else to retrieve the path    */
  554.    /* A function that does this is available in rexxextend.library   */
  555.    call trace b
  556.    parse arg FilePath, Part
  557.  
  558.    DivPos = max(lastpos(':', FilePath),lastpos('/', FilePath)) +1
  559.    if abbrev('FILE', upper(Part))
  560.       then return substr(FilePath, DivPos)
  561.    else
  562.       return strip(left(FilePath, DivPos-1),'T', '/')
  563.  
  564. RemUnknownLib: procedure
  565.     AddBackLibs = ''
  566.         /* remove library names not used to avoid problems    */
  567.     KnownLib = 'rexxsupport.library rexxarplib.library rexxreqtools.library RexxDosSupport.library REXX QuickSortPort'
  568.         /* A few libs that we know don't belong on the list */
  569.     BadLib = 'rexxsyslib.library reqtools.library arp.library'
  570.     CurLibs = show('l')
  571.     do i = 1 to words(CurLibs)
  572.         TLib = word(CurLibs,i)
  573.         if find(KnownLib, TLib) = 0 then do
  574.             call remlib(TLib)
  575.             if find(BadLib,TLib) = 0 then
  576.                 AddBackLibs = AddBackLibs TLib
  577.         end
  578.     end
  579.     return AddBackLibs
  580.  
  581. ReturnLibs:
  582.     do i = 1 to words(AddBackLibs)
  583.         if pos('.library', word(AddBackLibs,i)) > 0 then
  584.             call addlib(word(AddBackLibs, i), 0, -30, 0)
  585.         else
  586.             call addlib(word(AddBackLibs, i),-i-32)
  587.     end
  588.     AddBackLibs = ''    /* Changes the variable in calling environment */
  589.     return 0
  590.  
  591. LibVer: procedure
  592.    parse arg libname
  593.    if right(libname,8) ~= '.library' then
  594.       libname = libname'.library'
  595.    if ~showlist('L', libname) then
  596.       return -1
  597.    else do
  598.         LibAddress = showlist('L',libname,,'a')
  599.         call forbid    /* probibit multitasking during read       */
  600.         libver = import(offset(LibAddress,20),4)
  601.         call permit
  602.    end
  603.    return c2d(left(libver,2))'.'c2d(libver,2)
  604.  
  605. CheckLib: procedure
  606.     call trace b
  607.     CheckLib = 1
  608.     parse arg LibName, Priority, Offset, Version
  609.  
  610.     if LibName = '' then return 0    /* Must include a library name */
  611.  
  612.     signal on syntax
  613.  
  614.     if ~show('L', LibName) then do  /* Is the library already on the list? */
  615.           /* Set defaults for ADDLIB() */
  616.        if Priority = '' then Priority = 0
  617.        if Offset = '' then Offset = -30
  618.        if Version = '' then Version = 0
  619.           /* The return from the function doesn't matter, so use CALL¤¤    */
  620.        call addlib(LibName, Priority, Offset, Version)
  621.     end
  622.  
  623.        /* This call to a non-existent (I hope) function will force all     **
  624.        ** libraries to be loaded. It will generate a syntax error (#15)    **
  625.        ** but that will be trapped by the SIGNAL¤¤ instruction             */
  626.     call FooBarian()
  627.  
  628.        /* Unlikely we'd make it this far, but maybe someone will use       **
  629.        ** 'FooBarian' as a function name.                                  */
  630.     return 1
  631.  
  632. Syntax:
  633.     signal off syntax
  634.     if CheckLib = 1 then do        /* Use default Checklib() didn't call it */
  635.           /* This subroutine will be called on any syntax error. The call  **
  636.           ** to FooBarian() above is almost guaranteed to generate an      **
  637.           ** error. We're interested in the type of error. #14 means that  **
  638.           ** the library we tried to load isn't available. #15 is OK. It   **
  639.           ** means "Function not found" and we expect that.                */
  640.        if rc = 14 then do
  641.           call remlib(LibName)
  642.           return 0
  643.        end
  644.        else
  645.           return 1    /* Function not found, but library was loaded        */
  646.     end
  647.     else do
  648.         call PutErrMsg(SIGL, '+++ Error' rc 'in line' SIGL':' errortext(rc))
  649.         exit 0
  650.     end
  651.  
  652.    /* more to come */
  653. NoSupport:
  654.     call PutErrMsg(SIGL, 'rexxsupport.library could not be loaded.\Make sure the library is in your libs:\directory.')
  655.     exit 0
  656.  
  657. PutErrMsg:
  658.    call trace b
  659.    ErrMsg ='Sorry an enexpected error has occurred in line' arg(1)'.\\'arg(2)
  660.  
  661.    signal off syntax
  662.    signal off halt
  663.    signal off break_c
  664.    WinHi = 59 + CountChar('\', ErrMsg) * 11
  665.    if open(6ErrWin, 'raw:0/0/640/'WinHi'/Arx_Setup.rexx error/SCREEN *') then do
  666.       call writeln(6ErrWin, translate(ErrMsg,'0a'x, '\'))
  667.       call writech(6ErrWin, '0a'x'        -- Press any key -- ')
  668.       call readch(6ErrWin)
  669.    end
  670.     if symbol('ADDBACKLIBS') = 'VAR' & AddBackLibs > '' then
  671.         call ReturnLibs(AddBackLibs)
  672.     return 0
  673.  
  674. NoAGuide:
  675. NoARxPath:
  676.     if symbol('ADDBACKLIBS') = 'VAR' & AddBackLibs > '' then
  677.         call ReturnLibs(AddBackLibs)
  678.    exit 2
  679.